home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 7 / FM Towns Free Software Collection 7.iso / game / porepore / porepore.bas < prev    next >
BASIC Source File  |  1993-11-30  |  12KB  |  239 lines
  1. 10000 '********************************************************************
  2. 10010 '*            『ポレポレだ！！』                                    *
  3. 10020 '*       対戦型アクションパスル○×ゲーム                           *
  4. 10030 '*      制作  宮城県仙台第二高等学校物理部                          *
  5. 10040 '*      プログラム    本間 尚樹＆鈴木 賢                            *
  6. 10050 '*      キャラクター  本間 尚樹                                     *
  7. 10060 '*      ミュ－ジック  石川 友則（物理部員Ｉ）                       *
  8. 10070 '*         １９９１年３月２０日（水） 　                            *
  9. 10080 '*         １９９３年２月２６日（金） コイパイラ対応                *
  10. 10090 '*         １９９３年８月１３日（金） フリコレ７応募                *
  11. 10100 '********************************************************************
  12. 10110 DEFINT A-Z,○,×:LOAD@"fm_1.fmb"
  13. 10120 GOSUB 10810:MB=0
  14. 10130 GOSUB *タイトル:CLS:W(0)=0:W(1)=0:BGM 0:PLAY"T150@29O3B16>E2":BGM 1
  15. 10140 '*
  16. 10150 LINE(32+4*16,32)-(32+11*16+15,16+12*16-1),PSET,0,BF
  17. 10160 FOR I=0 TO 7
  18. 10170   C=I*16+128
  19. 10180   LINE(32+3*16+I,16+I)-(32+12*16+15-I,16+12*16+15-I),PSET,[C,C,C],B
  20. 10190   LINE(32+3*16+15-I,16+15-I)-(32+12*16+I,16+12*16+I),PSET,[C,C,C],B
  21. 10200 NEXT
  22. 10210 'FOR Y=0 TO 12:BF(3,Y)=7:BF(12,Y)=7:NEXT 
  23. 10220 FOR Y=1 TO 11
  24. 10230   FOR X=4 TO 11
  25. 10240     BF(X,Y)=0
  26. 10250   NEXT
  27. 10260 NEXT
  28. 10270 GOSUB *SON
  29. 10280 '******************  MAIN  ******************************************
  30. 10290 '*
  31. 10300 X=7:Y=1
  32. 10310 IF INKEY$<>"" THEN 10310
  33. 10320 P=0:CNT=0:GOSUB *SCHENGE:GOSUB *PUTCHR
  34. 10330 MX=0:PD=PAD(1+MB):PT=PTRIG(MB+1):IF PD<>0 THEN P=P+1 ELSE P=0
  35. 10340 X$=INKEY$:IF X$<>"" THEN P=9
  36. 10350 IF MB=1 THEN PD=PD-(X$=CHR$(&H1C))*3-(X$=CHR$(&H1D))*7-(X$=CHR$(&H1F))*5
  37. 10360 IF PD=3 AND (P=1 OR P>8) THEN MX=1 
  38. 10370 IF PD=7 AND (P=1 OR P>8) THEN MX=-1 
  39. 10380 IF BF(X+MX,Y)<>0 THEN MX=0
  40. 10390 X=X+MX:CNT=CNT+1:MY=0
  41. 10400 IF CNT>(3-W(MB))^2*4+4 THEN CNT=0:PLAY"T255@26O3L16DE-":MY=1:IF BF(X,Y+MY)<>0 THEN *積む
  42. 10410 IF PD=5 THEN MY=1:P=0:IF BF(X,Y+MY)<>0 THEN *積む ELSE Y=Y+MY:GOSUB *PUTCHR:FOR I=0 TO 50:NEXT:GOTO 10330
  43. 10420 Y=Y+MY:GOSUB *PUTCHR:WAIT 3
  44. 10430 '
  45. 10440 GOTO 10330
  46. 10450 '********************** 積む ****************************************
  47. 10460 *積む
  48. 10470 BF(X,Y)=MB+1:PLAY"T250@26O5L16D-FA-"
  49. 10480 IF MB=0 THEN PUT@A(X*16+32,Y*16+16)-(X*16+32+15,Y*16+16+15),○G
  50. 10490 IF MB=1 THEN PUT@A(X*16+32,Y*16+16)-(X*16+32+15,Y*16+16+15),×G
  51. 10500 '********************** 判定 ****************************************
  52. 10510 NN=0
  53. 10520 FOR II=-3 TO 3
  54. 10530   IF BF(X+II,Y)=MB+1 THEN NN=NN+1 ELSE NN=0'横
  55. 10540   IF NN>=4 THEN II=4:NEXT:GOTO *勝敗
  56. 10550 NEXT
  57. 10560 NN=0
  58. 10570 FOR II=0  TO 3:IF BF(X,Y+II)=MB+1 THEN NN=NN+1 ELSE NN=0'縦
  59. 10580   IF NN>=4 THEN II=4:NEXT:GOTO *勝敗
  60. 10590 NEXT
  61. 10600 IF Y>=3 THEN HH=-3 ELSE HH=-Y
  62. 10610 NN=0
  63. 10620 FOR II=HH TO 3:IF BF(X+II,Y+II)=MB+1 THEN NN=NN+1 ELSE NN=0'右下
  64. 10630   IF NN>=4 THEN II=4:NEXT:GOTO *勝敗
  65. 10640 NEXT
  66. 10650 NN=0
  67. 10660 FOR II=HH TO 3:IF BF(X-II,Y+II)=MB+1 THEN NN=NN+1 ELSE NN=0'左下
  68. 10670   IF NN>=4 THEN II=4:NEXT:GOTO *勝敗
  69. 10680 NEXT
  70. 10690 IF X=7 AND Y=1 THEN 10720 ELSE WC=0
  71. 10700 MB=MB+1:IF MB=2 THEN MB=0
  72. 10710 GOTO 10290
  73. 10720 WC=WC+1
  74. 10730 IF WC<4 THEN BEEP 1:FOR II=0 TO 500:NEXT:BEEP 0:LINE(X*16+32,Y*16+16)-STEP(15,15),PSET,0,BF
  75. 10740 IF WC>3 THEN BEEP 1:FOR II=0 TO 5000:NEXT:BEEP 0:MB=(MB+1)MOD 2:GOTO *勝敗
  76. 10750 GOTO 10290
  77. 10760 '****************** ＳＰＲＩＴＥ ************************************
  78. 10770 *SON:    SPRITE 0,0,1:RETURN
  79. 10780 *SOFF:   SPRITE 0,0,0:RETURN
  80. 10790 *SCHENGE :SPRITE 1,0,MB*4:RETURN 
  81. 10800 *PUTCHR:  SPRITE 6,0,X*16-SPRITE(0,6),Y*16+16-SPRITE(0,7):RETURN 
  82. 10810 '******************  初期 設定 **************************************
  83. 10820 SCREEN@1:COLOR 7,0:CLS:SPRITE ON
  84. 10830 DIM A(256),○G(256),×G(256),BF(16,16),W(1)
  85. 10840 FOR F=0 TO 1
  86. 10850 FOR I=0 TO 255
  87. 10860 READ A(I)
  88. 10870 IF A(I)=0 THEN A(I)=-32768
  89. 10880 NEXT
  90. 10890 DEF SPRITE 0,F*4,A,1
  91. 10900 NEXT
  92. 10910 DEF SPRITE 1,0,(0,0),0:SPRITE 5,0,0
  93. 10920 SPRITE SCREEN (32,0)
  94. 10930 RESTORE
  95. 10940 FOR I=0 TO 255:READ ○G(I):NEXT
  96. 10950 FOR I=0 TO 255:READ ×G(I):NEXT
  97. 10960 FOR X=3 TO 12:BF(X,0)=7:BF(X,12)=7:NEXT
  98. 10970 FOR Y=0 TO 12:BF(3,Y)=7:BF(12,Y)=7:NEXT 
  99. 10980 RETURN
  100. 10990 '**************** タイトル ******************************************
  101. 11000 *タイトル
  102. 11010 CLS:GOSUB *SOFF
  103. 11020 COLOR,7
  104. 11030 FOR I=0 TO 3
  105. 11040   FOR J=0 TO 3-I
  106. 11050     SYMBOL(160-16*4,32*(J+1)),KMID$("ポレポレポ",I MOD 2+1,4),2,2,0,,,8
  107. 11060     FOR K=0 TO 20'100
  108. 11070       GOSUB *TRIG
  109. 11080       IF F<>0 THEN K=1000:NEXT:J=3-I:NEXT:I=3:NEXT:GOTO 11440
  110. 11090     NEXT
  111. 11100     LINE(160-16*4,32*(J+1)-2)-STEP(32*4-1,32+1),PSET,0,BF
  112. 11110   NEXT
  113. 11120   SYMBOL(160-16*4,32*(J+1)),KMID$("ポレポレポ",I MOD 2+1,4),2,2,0,,,8
  114. 11130   FOR K=0 TO 20'100
  115. 11140     GOSUB *TRIG
  116. 11150     IF F<>0 THEN K=1000:NEXT:I=3:NEXT:GOTO 11440
  117. 11160   NEXT
  118. 11170 NEXT
  119. 11180 LINE(160-16*4,32*2-2-1)-STEP(32*4-1,1),PSET,0,B
  120. 11190 FOR I=0 TO 15
  121. 11200 RR1=R1:RR2=R2:R1=INT(RND*4):R2=INT(RND*4)
  122. 11210 IF R1=RR1 AND R2=RR2 THEN 11200
  123. 11220 FOR J!=0 TO 2 STEP .5!
  124. 11230   FOR K=0 TO 15'100
  125. 11240     GOSUB *TRIG:IF F<>0 THEN K=1000:J!=2:I=100:NEXT K,J!,I:GOTO 11440
  126. 11250   NEXT
  127. 11260  IF R1 MOD 2=R2 MOD 2 THEN 11280
  128. 11270  PUT@A(96+32*R1,32*(R2+2)-1)-(96+32*R1+15,32*(R2+2)+14),○G,,2,J!:GOTO 11290
  129. 11280  PUT@A(96+32*R1,32*(R2+2)-1)-(96+32*R1+15,32*(R2+2)+14),×G,,2,J!
  130. 11290 '*
  131. 11300 NEXT
  132. 11310 NEXT
  133. 11320 FLAG=(RND>=.5!)
  134. 11330 FOR J!=0 TO 2 STEP .5!/2
  135. 11340   FOR K=0 TO 15'100
  136. 11350     GOSUB *TRIG:IF F<>0 THEN K=1000:J!=2:NEXT K,J!:GOTO 11440
  137. 11360   NEXT
  138. 11370   IF FLAG=0 THEN PUT@A(96,32*2-1)-(96+15,32*2+14),○G,,8,J!*4 ELSE PUT@A(96,32*2-1)-(96+15,32*2+14),×G,,8,J!*4
  139. 11380 NEXT
  140. 11390 COLOR 7,0
  141. 11400 FOR I=0 TO 300'3000
  142. 11410   GOSUB *TRIG:IF F<>0 THEN I=3000
  143. 11420 NEXT
  144. 11430 GOTO 11010
  145. 11440 '*
  146. 11450 COLOR 7,0
  147. 11460 RETURN
  148. 11470 *TRIG:WAIT 1:IF PTRIG(1)=0 AND PTRIG(2)=0 THEN F=0 ELSE F=1
  149. 11480 RETURN
  150. 11490 '******************* 勝敗 ****************************************
  151. 11500 *勝敗
  152. 11510 GOSUB *SOFF
  153. 11520 IF MB=0 THEN XX=32 ELSE XX=240
  154. 11530 ON MB+1 GOTO 11540,11550
  155. 11540 PLAY"T120L16@20O5C8C<AFA8AGFD<B>C4","T120L16@20O4E8EEA4D4G4","T120L16@25O4C8CCFF8FD8<B8>G4":  PUT@A(XX,176-W(MB)*48)-(XX+15,176-W(MB)*48+15),○G,,3,3:GOTO 11560
  156. 11550 PLAY"T120@8L8O3EFA-AB{ABA}8FDE2","T120L8@8O3R4EFA-ABAA-2","T120L8O4@38CC@76CC@38CC@76CCC":  PUT@A(XX,176-W(MB)*48)-(XX+15,176-W(MB)*48+15),×G,,3,3
  157. 11560 IF W(MB)+1=4 AND MB=0 THEN PLAY"@28T180O3L8A4A>DF+AF+D< G4G>CEGEC< B>DFA GG+AB>C4r4l16o4eg>c","T180@26O4L4D<A>F+D C<G>EC U0 <BG>D<G>E "
  158. 11570 IF W(MB)+1=4 AND MB=1 THEN PLAY"@28T180O3L8 A4A>DF+ A F+D< G4G>CE-GE-C< B>DFA-GG+AB>C4r4l16o4e-g>c","T180@26O4L4D<A>F+D C<G>E-C U0 <BG>D<G>E- "
  159. 11580 '*  
  160. 11590 PF=0
  161. 11600 WHILE PF=0
  162. 11610   FOR II=0 TO 50:WAIT 1:IF PTRIG(1)<>0 OR PTRIG(2)<>0 THEN PF=1:II=1000
  163. 11620     NEXT
  164. 11630   LINE(XX,176-W(MB)*48)-(XX+47,176-W(MB)*48+47),XOR,7,BF
  165. 11640   FOR II=0 TO 50:WAIT 1::IF PTRIG(1)<>0 OR PTRIG(2)<>0 THEN PF=1:II=1000
  166. 11650     NEXT
  167. 11660   LINE(XX,176-W(MB)*48)-(XX+47,176-W(MB)*48+47),XOR,7,BF
  168. 11670 WEND
  169. 11680 W(MB)=W(MB)+1:IF W(MB)=4 THEN 10130
  170. 11690 MB=MB+1:IF MB=2 THEN MB=0
  171. 11700 GOTO 10140
  172. 11710 '****************** ＤＡＴＡ　************************************ 
  173. 11720 REM SPRITE(2) No00
  174. 11730 DATA &H7FFF, &H7FFF, &H7FFF, &H7FFF, &H7FFF, &H7FFF, &H7FFF, &H7FFF
  175. 11740 DATA &H7FFF, &H7FFF, &H7FFF, &H7FFF, &H7FFF, &H7FFF, &H7FFF, &H7FFF
  176. 11750 DATA &H7FFF, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H3DEF, &H3DEF
  177. 11760 DATA &H3DEF, &H3DEF, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H3DEF
  178. 11770 DATA &H7FFF, &H6F7B, &H6F7B, &H6F7B, &H3DEF, &H3DEF, &H6F7B, &H6F7B
  179. 11780 DATA &H6F7B, &H6F7B, &H3DEF, &H3DEF, &H6F7B, &H6F7B, &H6F7B, &H3DEF
  180. 11790 DATA &H7FFF, &H6F7B, &H6F7B, &H3DEF, &H6F7B, &H6F7B, &H6F7B, &H6F7B
  181. 11800 DATA &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H3DEF
  182. 11810 DATA &H7FFF, &H6F7B, &H3DEF, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B
  183. 11820 DATA &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H7FFF, &H6F7B, &H3DEF
  184. 11830 DATA &H7FFF, &H6F7B, &H3DEF, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B
  185. 11840 DATA &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H7FFF, &H6F7B, &H3DEF
  186. 11850 DATA &H7FFF, &H3DEF, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B
  187. 11860 DATA &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H7FFF, &H3DEF
  188. 11870 DATA &H7FFF, &H3DEF, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B
  189. 11880 DATA &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H7FFF, &H3DEF
  190. 11890 DATA &H7FFF, &H3DEF, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B
  191. 11900 DATA &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H7FFF, &H3DEF
  192. 11910 DATA &H7FFF, &H3DEF, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B
  193. 11920 DATA &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H7FFF, &H3DEF
  194. 11930 DATA &H7FFF, &H6F7B, &H3DEF, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B
  195. 11940 DATA &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H7FFF, &H6F7B, &H3DEF
  196. 11950 DATA &H7FFF, &H6F7B, &H3DEF, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B
  197. 11960 DATA &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H7FFF, &H6F7B, &H3DEF
  198. 11970 DATA &H7FFF, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B
  199. 11980 DATA &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H7FFF, &H6F7B, &H6F7B, &H3DEF
  200. 11990 DATA &H7FFF, &H6F7B, &H6F7B, &H6F7B, &H7FFF, &H7FFF, &H6F7B, &H6F7B
  201. 12000 DATA &H6F7B, &H6F7B, &H7FFF, &H7FFF, &H6F7B, &H6F7B, &H6F7B, &H3DEF
  202. 12010 DATA &H7FFF, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H7FFF, &H7FFF
  203. 12020 DATA &H7FFF, &H7FFF, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H3DEF
  204. 12030 DATA &H3DEF, &H3DEF, &H3DEF, &H3DEF, &H3DEF, &H3DEF, &H3DEF, &H3DEF
  205. 12040 DATA &H3DEF, &H3DEF, &H3DEF, &H3DEF, &H3DEF, &H3DEF, &H3DEF, &H3DEF
  206. 12050 REM SPRITE(2) No01
  207. 12060 DATA &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B
  208. 12070 DATA &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B, &H6F7B
  209. 12080 DATA &H6F7B, &H4A52, &H4A52, &H4A52, &H4A52, &H4A52, &H4A52, &H4A52
  210. 12090 DATA &H4A52, &H4A52, &H4A52, &H4A52, &H4A52, &H4A52, &H4A52, &H2D6B
  211. 12100 DATA &H6F7B, &H4A52, &H6F7B, &H3DEF, &H4A52, &H4A52, &H4A52, &H4A52
  212. 12110 DATA &H4A52, &H4A52, &H4A52, &H4A52, &H2D6B, &H6F7B, &H4A52, &H2D6B
  213. 12120 DATA &H6F7B, &H4A52, &H4A52, &H6F7B, &H3DEF, &H4A52, &H4A52, &H4A52
  214. 12130 DATA &H4A52, &H4A52, &H4A52, &H2D6B, &H6F7B, &H4A52, &H4A52, &H2D6B
  215. 12140 DATA &H6F7B, &H4A52, &H4A52, &H4A52, &H6F7B, &H3DEF, &H4A52, &H4A52
  216. 12150 DATA &H4A52, &H4A52, &H2D6B, &H6F7B, &H4A52, &H4A52, &H4A52, &H2D6B
  217. 12160 DATA &H6F7B, &H4A52, &H4A52, &H4A52, &H4A52, &H6F7B, &H3DEF, &H4A52
  218. 12170 DATA &H4A52, &H2D6B, &H6F7B, &H4A52, &H4A52, &H4A52, &H4A52, &H2D6B
  219. 12180 DATA &H6F7B, &H4A52, &H4A52, &H4A52, &H4A52, &H4A52, &H6F7B, &H3DEF
  220. 12190 DATA &H2D6B, &H6F7B, &H4A52, &H4A52, &H4A52, &H4A52, &H4A52, &H2D6B
  221. 12200 DATA &H6F7B, &H4A52, &H4A52, &H4A52, &H4A52, &H4A52, &H4A52, &H2D6B
  222. 12210 DATA &H6F7B, &H4A52, &H4A52, &H4A52, &H4A52, &H4A52, &H4A52, &H2D6B
  223. 12220 DATA &H6F7B, &H4A52, &H4A52, &H4A52, &H4A52, &H4A52, &H2D6B, &H6F7B
  224. 12230 DATA &H6F7B, &H3DEF, &H4A52, &H4A52, &H4A52, &H4A52, &H4A52, &H2D6B
  225. 12240 DATA &H6F7B, &H4A52, &H4A52, &H4A52, &H4A52, &H2D6B, &H6F7B, &H4A52
  226. 12250 DATA &H4A52, &H6F7B, &H3DEF, &H4A52, &H4A52, &H4A52, &H4A52, &H2D6B
  227. 12260 DATA &H6F7B, &H4A52, &H4A52, &H4A52, &H2D6B, &H6F7B, &H4A52, &H4A52
  228. 12270 DATA &H4A52, &H4A52, &H6F7B, &H3DEF, &H4A52, &H4A52, &H4A52, &H2D6B
  229. 12280 DATA &H6F7B, &H4A52, &H4A52, &H2D6B, &H6F7B, &H4A52, &H4A52, &H4A52
  230. 12290 DATA &H4A52, &H4A52, &H4A52, &H6F7B, &H3DEF, &H4A52, &H4A52, &H2D6B
  231. 12300 DATA &H6F7B, &H4A52, &H2D6B, &H6F7B, &H4A52, &H4A52, &H4A52, &H4A52
  232. 12310 DATA &H4A52, &H4A52, &H4A52, &H4A52, &H6F7B, &H3DEF, &H4A52, &H2D6B
  233. 12320 DATA &H6F7B, &H4A52, &H6F7B, &H4A52, &H4A52, &H4A52, &H4A52, &H4A52
  234. 12330 DATA &H4A52, &H4A52, &H4A52, &H4A52, &H4A52, &H6F7B, &H3DEF, &H2D6B
  235. 12340 DATA &H6F7B, &H4A52, &H4A52, &H4A52, &H4A52, &H4A52, &H4A52, &H4A52
  236. 12350 DATA &H4A52, &H4A52, &H4A52, &H4A52, &H4A52, &H4A52, &H4A52, &H2D6B
  237. 12360 DATA &H2D6B, &H2D6B, &H2D6B, &H2D6B, &H2D6B, &H2D6B, &H2D6B, &H2D6B
  238. 12370 DATA &H2D6B, &H2D6B, &H2D6B, &H2D6B, &H2D6B, &H2D6B, &H2D6B, &H2D6B
  239.